Module-Build
5 results

 view release on metacpan or  search on metacpan

lib/Module/Build/Base.pm  view on Meta::CPAN 


sub expand_test_dir {
  my ($self, $dir) = @_;
  my $exts = $self->{properties}{test_file_exts};

  return sort map { @{$self->rscan_dir($dir, qr{^[^.].*\Q$_\E$})} } @$exts
    if $self->recursive_test_files;

  return sort map { glob File::Spec->catfile($dir, "*$_") } @$exts;
}

sub ACTION_testdb {
  my ($self) = @_;
  local $self->{properties}{debugger} = 1;
  $self->depends_on('test');
}

sub ACTION_testcover {
  my ($self) = @_;

  unless (Module::Metadata->find_module_by_name('Devel::Cover')) {
    warn("Cannot run testcover action unless Devel::Cover is installed.\n");
    return;
  }

  $self->add_to_cleanup('coverage', 'cover_db');
  $self->depends_on('code');

  # See whether any of the *.pm files have changed since last time
  # testcover was run.  If so, start over.
  if (-e 'cover_db') {
    my $pm_files = $self->rscan_dir
        (File::Spec->catdir($self->blib, 'lib'), $self->file_qr('\.pm$') );
    my $cover_files = $self->rscan_dir('cover_db', sub {-f $_ and not /\.html$/});

    $self->do_system(qw(cover -delete))
      unless $self->up_to_date($pm_files,         $cover_files)
          && $self->up_to_date($self->test_files, $cover_files);
  }

  local $self->{properties}{cover} = 1;
  $self->depends_on('test');
  $self->do_system('cover');
}

sub ACTION_code {
  my ($self) = @_;

  # All installable stuff gets created in blib/ .
  # Create blib/arch to keep blib.pm happy
  my $blib = $self->blib;
  $self->add_to_cleanup($blib);
  File::Path::mkpath( File::Spec->catdir($blib, 'arch') );

  if (my $split = $self->autosplit) {
    $self->autosplit_file($_, $blib) for ref($split) ? @$split : ($split);
  }

  foreach my $element (@{$self->build_elements}) {
    my $method = "process_${element}_files";
    $method = "process_files_by_extension" unless $self->can($method);
    $self->$method($element);
  }

  $self->depends_on('config_data');
}

sub ACTION_build {
  my $self = shift;
  $self->log_info("Building " . $self->dist_name . "\n");
  $self->depends_on('code');
  $self->depends_on('docs');
}

sub process_files_by_extension {
  my ($self, $ext) = @_;

  my $method = "find_${ext}_files";
  my $files = $self->can($method) ? $self->$method() : $self->_find_file_by_type($ext,  'lib');

  foreach my $file (sort keys %$files) {
    $self->copy_if_modified(from => $file, to => File::Spec->catfile($self->blib, $files->{$file}) );
  }
}

sub process_support_files {
  my $self = shift;
  my $p = $self->{properties};
  return unless $p->{c_source};
  return if $self->pureperl_only && $self->allow_pureperl;

  my $files;
  if (ref($p->{c_source}) eq "ARRAY") {
      push @{$p->{include_dirs}}, @{$p->{c_source}};
      for my $path (@{$p->{c_source}}) {
          push @$files, @{ $self->rscan_dir($path, $self->file_qr('\.c(c|p|pp|xx|\+\+)?$')) };
      }
  } else {
      push @{$p->{include_dirs}}, $p->{c_source};
      $files = $self->rscan_dir($p->{c_source}, $self->file_qr('\.c(c|p|pp|xx|\+\+)?$'));
  }

  foreach my $file (@$files) {
      push @{$p->{objects}}, $self->compile_c($file);
  }
}

sub process_share_dir_files {
  my $self = shift;
  my $files = $self->_find_share_dir_files;
  return unless $files;

  # root for all File::ShareDir paths
  my $share_prefix = File::Spec->catdir($self->blib, qw/lib auto share/);

  # copy all share files to blib
  foreach my $file (sort keys %$files) {
    $self->copy_if_modified(
      from => $file, to => File::Spec->catfile( $share_prefix, $files->{$file} )
    );
  }
}

sub _find_share_dir_files {
  my $self = shift;
  my $share_dir = $self->share_dir;
  return unless $share_dir;

  my @file_map;
  if ( $share_dir->{dist} ) {
    my $prefix = "dist/".$self->dist_name;
    push @file_map, $self->_share_dir_map( $prefix, $share_dir->{dist} );
  }

  if ( $share_dir->{module} ) {
    for my $mod ( sort keys %{ $share_dir->{module} } ) {
      (my $altmod = $mod) =~ s{::}{-}g;
      my $prefix = "module/$altmod";
      push @file_map, $self->_share_dir_map($prefix, $share_dir->{module}{$mod});
    }
  }

  return { @file_map };
}

sub _share_dir_map {
  my ($self, $prefix, $list) = @_;
  my %files;
  for my $dir ( @$list ) {
    for my $f ( @{ $self->rscan_dir( $dir, sub {-f} )} ) {
      $f =~ s{\A.*?\Q$dir\E/}{};
      $files{"$dir/$f"} = "$prefix/$f";
    }
  }
  return %files;
}

sub process_PL_files {
  my ($self) = @_;
  my $files = $self->find_PL_files;

  foreach my $file (sort keys %$files) {
    my $to = $files->{$file};
    unless ($self->up_to_date( $file, $to )) {
      $self->run_perl_script($file, [], [@$to]) or die "$file failed";
      $self->add_to_cleanup(@$to);
    }
  }
}

sub process_xs_files {
  my $self = shift;
  return if $self->pureperl_only && $self->allow_pureperl;
  my $files = $self->find_xs_files;
  croak 'Can\'t build xs files under --pureperl-only' if %$files && $self->pureperl_only;
  foreach my $from (sort keys %$files) {
    my $to = $files->{$from};
    unless ($from eq $to) {
      $self->add_to_cleanup($to);
      $self->copy_if_modified( from => $from, to => $to );
    }
    $self->process_xs($to);
  }
}

sub process_pod_files { shift()->process_files_by_extension(shift()) }
sub process_pm_files  { shift()->process_files_by_extension(shift()) }

sub process_script_files {
  my $self = shift;
  my $files = $self->find_script_files;
  return unless keys %$files;

  my $script_dir = File::Spec->catdir($self->blib, 'script');
  File::Path::mkpath( $script_dir );

  foreach my $file (sort keys %$files) {
    my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next;
    $self->fix_shebang_line($result) unless $self->is_vmsish;
    $self->make_executable($result);
  }
}

sub find_PL_files {
  my $self = shift;
  if (my $files = $self->{properties}{PL_files}) {
    # 'PL_files' is given as a Unix file spec, so we localize_file_path().

    if (ref $files eq 'ARRAY') {
      return { map {$_, [/^(.*)\.PL$/]}
               map $self->localize_file_path($_),
               @$files };

    } elsif (ref $files eq 'HASH') {
      my %out;
      while (my ($file, $to) = each %$files) {
        $out{ $self->localize_file_path($file) } = [ map $self->localize_file_path($_),
                                                     ref $to ? @$to : ($to) ];
      }
      return \%out;

    } else {
      die "'PL_files' must be a hash reference or array reference";
    }
  }

  return unless -d 'lib';
  return {
    map {$_, [/^(.*)\.PL$/i ]}
    @{ $self->rscan_dir('lib', $self->file_qr('\.PL$')) }
  };
}

sub find_pm_files  { shift->_find_file_by_type('pm',  'lib') }
sub find_pod_files { shift->_find_file_by_type('pod', 'lib') }
sub find_xs_files  { shift->_find_file_by_type('xs',  'lib') }

sub find_script_files {
  my $self = shift;
  if (my $files = $self->script_files) {
    # Always given as a Unix file spec.  Values in the hash are
    # meaningless, but we preserve if present.
    return { map {$self->localize_file_path($_), $files->{$_}} keys %$files };
  }

  # No default location for script files
  return {};
}

sub find_test_files {
  my $self = shift;
  my $p = $self->{properties};

  if (my $files = $p->{test_files}) {
    $files = [sort keys %$files] if ref $files eq 'HASH';
    $files = [map { -d $_ ? $self->expand_test_dir($_) : $_ }
              map glob,
              $self->split_like_shell($files)];

lib/Module/Build/Base.pm  view on Meta::CPAN 

  foreach my $item (map glob($_), $self->cleanup) {
    $self->delete_filetree($item);
  }
}

sub ACTION_realclean {
  my ($self) = @_;
  $self->depends_on('clean');
  $self->log_info("Cleaning up configuration files\n");
  $self->delete_filetree(
    $self->config_dir, $self->mymetafile, $self->mymetafile2, $self->build_script
  );
}

sub ACTION_ppd {
  my ($self) = @_;

  require Module::Build::PPMMaker;
  my $ppd = Module::Build::PPMMaker->new();
  my $file = $ppd->make_ppd(%{$self->{args}}, build => $self);
  $self->add_to_cleanup($file);
}

sub ACTION_ppmdist {
  my ($self) = @_;

  $self->depends_on( 'build' );

  my $ppm = $self->ppm_name;
  $self->delete_filetree( $ppm );
  $self->log_info( "Creating $ppm\n" );
  $self->add_to_cleanup( $ppm, "$ppm.tar.gz" );

  my %types = ( # translate types/dirs to those expected by ppm
    lib     => 'lib',
    arch    => 'arch',
    bin     => 'bin',
    script  => 'script',
    bindoc  => 'man1',
    libdoc  => 'man3',
    binhtml => undef,
    libhtml => undef,
  );

  foreach my $type ($self->install_types) {
    next if exists( $types{$type} ) && !defined( $types{$type} );

    my $dir = File::Spec->catdir( $self->blib, $type );
    next unless -e $dir;

    my $files = $self->rscan_dir( $dir );
    foreach my $file ( @$files ) {
      next unless -f $file;
      my $rel_file =
        File::Spec->abs2rel( File::Spec->rel2abs( $file ),
                             File::Spec->rel2abs( $dir  ) );
      my $to_file  =
        File::Spec->catfile( $ppm, 'blib',
                            exists( $types{$type} ) ? $types{$type} : $type,
                            $rel_file );
      $self->copy_if_modified( from => $file, to => $to_file );
    }
  }

  foreach my $type ( qw(bin lib) ) {
    $self->htmlify_pods( $type, File::Spec->catdir($ppm, 'blib', 'html') );
  }

  # create a tarball;
  # the directory tar'ed must be blib so we need to do a chdir first
  my $target = File::Spec->catfile( File::Spec->updir, $ppm );
  $self->_do_in_dir( $ppm, sub { $self->make_tarball( 'blib', $target ) } );

  $self->depends_on( 'ppd' );

  $self->delete_filetree( $ppm );
}

sub ACTION_pardist {
  my ($self) = @_;

  # Need PAR::Dist
  if ( not eval { require PAR::Dist; PAR::Dist->VERSION(0.17) } ) {
    $self->log_warn(
      "In order to create .par distributions, you need to\n"
      . "install PAR::Dist first."
    );
    return();
  }

  $self->depends_on( 'build' );

  return PAR::Dist::blib_to_par(
    name => $self->dist_name,
    version => $self->dist_version,
  );
}

sub ACTION_dist {
  my ($self) = @_;

  # MUST dispatch() and not depends_ok() so we generate a clean distdir
  $self->dispatch('distdir');

  my $dist_dir = $self->dist_dir;

  $self->make_tarball($dist_dir);
  $self->delete_filetree($dist_dir);
}

sub ACTION_distcheck {
  my ($self) = @_;

  $self->_check_manifest_skip unless $self->invoked_action eq 'distclean';

  require ExtUtils::Manifest;
  local $^W; # ExtUtils::Manifest is not warnings clean.
  my ($missing, $extra) = ExtUtils::Manifest::fullcheck();

  return unless @$missing || @$extra;

lib/Module/Build/Base.pm  view on Meta::CPAN 

      close $fh;
    } else {
      $self->log_warn(
        "Cannot create 'README' file: Can't open file for writing\n" );
      return;
    }

  } else {
    $self->log_warn("Can't load Pod::Readme or Pod::Text to create README\n");
    return;
  }

  $self->_add_to_manifest('MANIFEST', 'README');
}

sub _main_docfile {
  my $self = shift;
  if ( my $pm_file = $self->dist_version_from ) {
    (my $pod_file = $pm_file) =~ s/.pm$/.pod/;
    return (-e $pod_file ? $pod_file : $pm_file);
  } else {
    return undef;
  }
}

sub do_create_bundle_inc {
  my $self = shift;
  my $dist_inc = File::Spec->catdir( $self->dist_dir, 'inc' );
  require inc::latest;
  inc::latest->write($dist_inc, @{$self->bundle_inc_preload});
  inc::latest->bundle_module($_, $dist_inc) for @{$self->bundle_inc};
  return 1;
}

sub ACTION_distdir {
  my ($self) = @_;

  if ( @{$self->bundle_inc} && ! $self->_mb_feature('inc_bundling_support') ) {
    $self->_warn_mb_feature_deps('inc_bundling_support');
    die "Aborting.\n";
  }

  $self->depends_on('distmeta');

  my $dist_files = $self->_read_manifest('MANIFEST')
    or die "Can't create distdir without a MANIFEST file - run 'manifest' action first.\n";
  delete $dist_files->{SIGNATURE};  # Don't copy, create a fresh one
  die "No files found in MANIFEST - try running 'manifest' action?\n"
    unless ($dist_files and keys %$dist_files);
  my $metafile = $self->metafile;
  $self->log_warn("*** Did you forget to add $metafile to the MANIFEST?\n")
    unless exists $dist_files->{$metafile};

  my $dist_dir = $self->dist_dir;
  $self->delete_filetree($dist_dir);
  $self->log_info("Creating $dist_dir\n");
  $self->add_to_cleanup($dist_dir);

  foreach my $file (sort keys %$dist_files) {
    next if $file =~ m{^MYMETA\.}; # Double check that we skip MYMETA.*
    my $new = $self->copy_if_modified(from => $file, to_dir => $dist_dir, verbose => 0);
  }

  $self->do_create_bundle_inc if @{$self->bundle_inc};

  $self->_sign_dir($dist_dir) if $self->{properties}{sign};
}

sub ACTION_disttest {
  my ($self) = @_;

  $self->depends_on('distdir');

  $self->_do_in_dir
    ( $self->dist_dir,
      sub {
        local $ENV{AUTHOR_TESTING}  = 1;
        local $ENV{RELEASE_TESTING} = 1;

        # XXX could be different names for scripts

        $self->run_perl_script('Build.PL') # XXX Should this be run w/ --nouse-rcfile
          or die "Error executing 'Build.PL' in dist directory: $!";
        $self->run_perl_script($self->build_script)
          or die "Error executing $self->build_script in dist directory: $!";
        $self->run_perl_script($self->build_script, [], ['test'])
          or die "Error executing 'Build test' in dist directory";
      });
}

sub ACTION_distinstall {
  my ($self, @args) = @_;

  $self->depends_on('distdir');

  $self->_do_in_dir ( $self->dist_dir,
    sub {
      $self->run_perl_script('Build.PL')
        or die "Error executing 'Build.PL' in dist directory: $!";
      $self->run_perl_script($self->build_script)
        or die "Error executing $self->build_script in dist directory: $!";
      $self->run_perl_script($self->build_script, [], ['install'])
        or die "Error executing 'Build install' in dist directory";
    }
  );
}

=begin private

  my $has_include = $build->_eumanifest_has_include;

Returns true if the installed version of ExtUtils::Manifest supports
#include and #include_default directives.  False otherwise.

=end private

=cut

# #!include and #!include_default were added in 1.50
sub _eumanifest_has_include {
    my $self = shift;

lib/Module/Build/Base.pm  view on Meta::CPAN 

sub process_xs {
  my ($self, $file) = @_;

  my $spec = $self->_infer_xs_spec($file);

  # File name, minus the suffix
  (my $file_base = $file) =~ s/\.[^.]+$//;

  # .xs -> .c
  $self->add_to_cleanup($spec->{c_file});

  unless ($self->up_to_date($file, $spec->{c_file})) {
    $self->compile_xs($file, outfile => $spec->{c_file});
  }

  # .c -> .o
  my $v = $self->dist_version;
  $self->compile_c($spec->{c_file},
                   defines => {VERSION => qq{"$v"}, XS_VERSION => qq{"$v"}});

  # archdir
  File::Path::mkpath($spec->{archdir}, 0, oct(777)) unless -d $spec->{archdir};

  # .xs -> .bs
  $self->add_to_cleanup($spec->{bs_file});
  unless ($self->up_to_date($file, $spec->{bs_file})) {
    require ExtUtils::Mkbootstrap;
    $self->log_info("ExtUtils::Mkbootstrap::Mkbootstrap('$spec->{bs_file}')\n");
    ExtUtils::Mkbootstrap::Mkbootstrap($spec->{bs_file});  # Original had $BSLOADLIBS - what's that?
    open(my $fh, '>>', $spec->{bs_file});  # create
    utime((time)x2, $spec->{bs_file});  # touch
  }

  # .o -> .(a|bundle)
  $self->link_c($spec);
}

sub do_system {
  my ($self, @cmd) = @_;
  $self->log_verbose("@cmd\n");

  # Some systems proliferate huge PERL5LIBs, try to ameliorate:
  my %seen;
  my $sep = $self->config('path_sep');
  local $ENV{PERL5LIB} =
    ( !exists($ENV{PERL5LIB}) ? '' :
      length($ENV{PERL5LIB}) < 500
      ? $ENV{PERL5LIB}
      : join $sep, grep { ! $seen{$_}++ and -d $_ } split($sep, $ENV{PERL5LIB})
    );

  my $status = system(@cmd);
  if ($status and $! =~ /Argument list too long/i) {
    my $env_entries = '';
    foreach (sort keys %ENV) { $env_entries .= "$_=>".length($ENV{$_})."; " }
    warn "'Argument list' was 'too long', env lengths are $env_entries";
  }
  return !$status;
}

sub copy_if_modified {
  my $self = shift;
  my %args = (@_ > 3
              ? ( @_ )
              : ( from => shift, to_dir => shift, flatten => shift )
             );
  $args{verbose} = !$self->quiet
    unless exists $args{verbose};

  my $file = $args{from};
  unless (defined $file and length $file) {
    die "No 'from' parameter given to copy_if_modified";
  }

  # makes no sense to replicate an absolute path, so assume flatten
  $args{flatten} = 1 if File::Spec->file_name_is_absolute( $file );

  my $to_path;
  if (defined $args{to} and length $args{to}) {
    $to_path = $args{to};
  } elsif (defined $args{to_dir} and length $args{to_dir}) {
    $to_path = File::Spec->catfile( $args{to_dir}, $args{flatten}
                                    ? File::Basename::basename($file)
                                    : $file );
  } else {
    die "No 'to' or 'to_dir' parameter given to copy_if_modified";
  }

  return if $self->up_to_date($file, $to_path); # Already fresh

  {
    local $self->{properties}{quiet} = 1;
    $self->delete_filetree($to_path); # delete destination if exists
  }

  # Create parent directories
  File::Path::mkpath(File::Basename::dirname($to_path), 0, oct(777));

  $self->log_verbose("Copying $file -> $to_path\n");

  if ($^O eq 'os2') {# copy will not overwrite; 0x1 = overwrite
    chmod 0666, $to_path;
    File::Copy::syscopy($file, $to_path, 0x1) or die "Can't copy('$file', '$to_path'): $!";
  } else {
    File::Copy::copy($file, $to_path) or die "Can't copy('$file', '$to_path'): $!";
  }

  # mode is read-only + (executable if source is executable)
  my $mode = oct(444) | ( $self->is_executable($file) ? oct(111) : 0 );
  chmod( $mode, $to_path );

  return $to_path;
}

sub up_to_date {
  my ($self, $source, $derived) = @_;
  $source  = [$source]  unless ref $source;
  $derived = [$derived] unless ref $derived;

  # empty $derived means $source should always run
  return 0 if @$source && !@$derived || grep {not -e} @$derived;

  my $most_recent_source = time / (24*60*60);
  foreach my $file (@$source) {
    unless (-e $file) {
      $self->log_warn("Can't find source file $file for up-to-date check");
      next;
    }
    $most_recent_source = -M _ if -M _ < $most_recent_source;
  }

  foreach my $derived (@$derived) {
    return 0 if -M $derived > $most_recent_source;
  }
  return 1;
}

sub dir_contains {
  my ($self, $first, $second) = @_;
  # File::Spec doesn't have an easy way to check whether one directory
  # is inside another, unfortunately.

  ($first, $second) = map File::Spec->canonpath($_), ($first, $second);
  my @first_dirs = File::Spec->splitdir($first);
  my @second_dirs = File::Spec->splitdir($second);



( run in 0.413 second using v1.01-cache-2.11-cpan-fd5d4e115d8 )